RQ1
Perceived unkindness of the messages can likely affect the message level outcomes. What is the relationship between perceived unkindness of the messages and the message level outcomes, specifically, motivation to engage in social distancing, and self and social relevance of the messages?
tl;dr: Perceived kindness is positively associated with all message level outcomes: 1) self relevance, 2) social relevance, 3) self motivation, 4) social motivation, and 5) intention to share.
Results:
lmer(msg_rel_self ~ msg_kind_1 + (1|condition) + (1|message_id) + (1|SID), data = data_mod)
| (Intercept) |
0.003 |
0.153 |
4.598 |
0.019 |
0.986 |
| msg_kind_1 |
0.304 |
0.012 |
5826.27 |
26.281 |
<0.001 |
lmer(msg_rel_social ~ msg_kind_1 + (1|condition) + (1|message_id) + (1|SID), data = data_mod)
| (Intercept) |
0.002 |
0.109 |
5 |
0.018 |
0.986 |
| msg_kind_1 |
0.312 |
0.012 |
5742.183 |
26.294 |
<0.001 |
lmer(msg_motiv_self ~ msg_kind_1 + (1|condition) + (1|message_id) + (1|SID), data = data_mod)
| (Intercept) |
0.001 |
0.102 |
5.037 |
0.011 |
0.992 |
| msg_kind_1 |
0.331 |
0.011 |
4064.233 |
28.945 |
<0.001 |
lmer(msg_motiv_other ~ msg_kind_1 + (1|condition) + (1|message_id) + (1|SID), data = data_mod)
| (Intercept) |
0.001 |
0.091 |
4.481 |
0.013 |
0.99 |
| msg_kind_1 |
0.337 |
0.012 |
1534.869 |
29.14 |
<0.001 |
lmer(msg_share ~ msg_kind_1 + (1|condition) + (1|message_id) + (1|SID), data = data_mod)
| (Intercept) |
0 |
0.065 |
5.087 |
-0.006 |
0.996 |
| msg_kind_1 |
0.309 |
0.011 |
2181.268 |
28.565 |
<0.001 |
Plot:
p1 <- data_mod_person %>%
ggplot(aes(msg_kind_1, msg_rel_self, color = condition)) +
geom_point(size=0.5) +
scale_color_manual(values = palette_cond_humorstudy) +
geom_smooth(method = "lm", color = "black") +
xlab("Perceived kindness of message") +
ylab("Self relevance") +
theme_light() +
theme(legend.position = "none")
p2 <- data_mod_person %>%
ggplot(aes(msg_kind_1, msg_rel_social, color = condition)) +
geom_point(size=0.5) +
scale_color_manual(values = palette_cond_humorstudy) +
geom_smooth(method = "lm", color = "black") +
xlab("Perceived kindness of message") +
ylab("Social relevance") +
theme_light() +
theme(legend.position = "none")
p3 <- data_mod_person %>%
ggplot(aes(msg_kind_1, msg_motiv_self, color = condition)) +
geom_point(size=0.5) +
scale_color_manual(values = palette_cond_humorstudy) +
geom_smooth(method = "lm", color = "black") +
xlab("Perceived kindness of message") +
ylab("Self motivation") +
theme_light() +
theme(legend.position = "none")
p4 <- data_mod_person %>%
ggplot(aes(msg_kind_1, msg_motiv_other, color = condition)) +
geom_point(size=0.5) +
scale_color_manual(values = palette_cond_humorstudy) +
geom_smooth(method = "lm", color = "black") +
xlab("Perceived kindness of message") +
ylab("Social motivation") +
theme_light() +
theme(legend.position = "none")
p5 <- data_mod_person %>%
ggplot(aes(msg_kind_1, msg_share, color = condition)) +
geom_point(size=0.5) +
scale_color_manual(values = palette_cond_humorstudy) +
geom_smooth(method = "lm", color = "black") +
xlab("Perceived kindness of message") +
ylab("Intent to share") +
theme_light() +
theme(legend.position = "none")
grid.arrange(p1, p2, p3, p4, p5)

RQ2
Empathic concerns of individuals can affect their interaction with mocking messages. What is the moderating effect of empathic concern on the relationship between mocking humor and perceived kindness of the messages?
tl;dr: Empathy postively moderates the effect of mocking messages on perceived kindness: mocking messages were rated as more kind by individuals with higher empathic concern, as compared to individuals with lower empathic concern.
Code:
lmer(msg_kind_1 ~ condition*empathy + (1|SID) + (1|message_id), data = data_test)
Results:
| (Intercept) |
-0.037 |
0.239 |
109.373 |
-0.154 |
0.878 |
| conditionmocking |
-1.614 |
0.309 |
792.947 |
-5.223 |
<0.001 |
| empathy |
0.112 |
0.07 |
792.947 |
1.602 |
0.11 |
| mocking:empathy |
0.262 |
0.1 |
792.947 |
2.623 |
0.009 |
Plot:

RQ3
Across experimental groups, are there differences in perceived norms about social distancing in town/city?
tl;dr: No significant difference in norms across mocking, non-mocking and fact-based conditions.
Code:
mod <- anova(lm(norms_town ~ condition, data = data_mod_person))
Results
Plot

RQ4
Across experimental groups, are there differences in various beliefs about social distancing?
tl;dr: No significant difference in any belief measure across mocking, non-mocking and fact-based conditions.
Code:
mod <- anova(lm(belief ~ condition, data = data_mod_person))
Results
Click for belief items
- beliefs_mental: If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick, I will: avoid chaos/feel lonely/hurt mental health.
- beliefs_others_home: If other people stay home and avoid all social contact, it is less important for me to.
- beliefs_safe_others: If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick I will: keep others/family members safe/prevent spread of COVID-19.
- beliefs_safe_self: If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick: keep myself safe/will be less likely to get sick.
- beliefs_infect_now: How many people do you think will be infected with coronavirus in the USA 1 month from now?
- beliefs_norms: If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick: it will be accepted by friends/family/coworkers.
- beliefs_environment: If I stay home every day for the next two weeks, and avoid social contact, even if I’m not sick: it will create less pollution/will be good for environment.
- beliefs_infect_month: How many people do you think will be infected with coronavirus in the USA 1 month from now?
list_of_beliefs <- data_tidy %>%
filter(grepl("beliefs", item)) %>%
dplyr::select(survey_name) %>%
unique()
res <- data.frame(belief = character(), Df = numeric(), Sumsq = numeric(),
Meansq = numeric(), Fval = numeric(), Pr = numeric())
for (b in list_of_beliefs$survey_name) {
mod_txt <- paste0(b, "~ condition")
s <- anova(lm(mod_txt, data = data_mod_person))
res <- rbind(res, data.frame(belief = b, Df = s$Df[1], Sumsq = s$`Sum Sq`[1],
Meansq = s$`Mean Sq`[1], Fval = s$`F value`[1], Pr = s$`Pr(>F)`[1]))
}
pander(res, caption = "Anova results for (belief ~ condition) models.")
Anova results for (belief ~ condition) models.
| beliefs_mental |
2 |
1.181 |
0.5905 |
0.5901 |
0.5545 |
| beliefs_others_home |
2 |
0.03276 |
0.01638 |
0.01636 |
0.9838 |
| beliefs_safe_others |
2 |
1.387 |
0.6935 |
0.6932 |
0.5002 |
| beliefs_safe_self |
2 |
0.3138 |
0.1569 |
0.1567 |
0.855 |
| beliefs_infect_now |
2 |
1.903 |
0.9517 |
0.9517 |
0.3864 |
| beliefs_norms |
2 |
0.01627 |
0.008136 |
0.008122 |
0.9919 |
| beliefs_environment |
2 |
0.9516 |
0.4758 |
0.4754 |
0.6218 |
| beliefs_infect_month |
2 |
3.229 |
1.615 |
1.616 |
0.1991 |
Plot

RQ5
Across experimental groups, are there differences in support for public policy regarding COVID-19 which support vulnerable populations?
tl;dr: No significant difference in any belief measure across mocking, non-mocking and fact-based conditions.
Code:
mod <- anova(lm(policy ~ condition, data = data_mod_person))
Results
list_of_policy <- data_tidy %>%
filter(grepl("policy", survey_name)) %>%
dplyr::select(survey_name) %>%
unique()
res <- data.frame(policy = character(), Df = numeric(), Sumsq = numeric(),
Meansq = numeric(), Fval = numeric(), Pr = numeric())
for (p in list_of_policy$survey_name) {
mod_txt <- paste0(p, "~ condition")
s <- anova(lm(mod_txt, data = data_mod_person))
p_name = ""
if (p == "policy") {
p_name = "Proposed policies to contain COVID-19"
}
if (p == "policy2") {
p_name = "Government response priorities"
}
if (p == "policy1") {
p_name = "Differential policies for young and old"
}
res <- rbind(res, data.frame(policy = p_name, Df = s$Df[1], Sumsq = s$`Sum Sq`[1],
Meansq = s$`Mean Sq`[1], Fval = s$`F value`[1], Pr = s$`Pr(>F)`[1]))
}
colnames(res)[1] <- "Support for"
pander(res, caption = "Anova results for (policy ~ condition) models.")
Anova results for (policy ~ condition) models.
| Proposed policies to contain COVID-19 |
2 |
0.01389 |
0.006944 |
0.006933 |
0.9931 |
| Government response priorities |
2 |
1.007 |
0.5033 |
0.5029 |
0.6049 |
| Differential policies for young and old |
2 |
2.076 |
1.038 |
1.038 |
0.3544 |
Click for policy items
Proposed policies to contain COVID-19
To what extent do you support the following policies in response to the COVID-19 pandemic?
- Increased funding for Coronavirus research, and vaccine development.
- Two weeks of paid sick leave for workers during the COVID-19 pandemic to help those impacted by quarantine orders or those who must stay home to care for children.
- Paid leave at 67% of average monthly earnings for unemployment caused by COVID-19.
- Free coronavirus testing (including emergency room visits and doctor fees) for all U.S. citizens and permanent residents.
- Two rounds of direct payment to taxpayers of on average $1000 each to help with short-term economic fallout from the COVID-19 pandemic.
- Expanded coverage of small business loans to help small companies with fewer than 500 employees to navigate the economic fallout from the COVID-19 pandemic.
- Bailouts for large corporations negatively affected by the pandemic (e.g., airlines, hotels, casinos, cruise line operators, shopping mall operators, etc.).
- Closing borders to all, except U.S. citizens and permanent residents, to help slow the spread of the coronavirus across borders.
- Increased government surveillance and tracking of Americans, residents, and non-residents to monitor the spread of COVID-19.
- Closing immigration courts and detention centers to reduce the spread of COVID-19.
- Publicly funded health insurance (“Medicare for all”) to ensure adequate health coverage for all during the current and future pandemics.
- Expand access to food assistance programs, such as SNAP and WIC, to help with short-term economic fallout from the COVID-19 pandemic.
- Require all non-essential employees to shelter-in-place (i.e., stay in homes and limit travel to only essential trips) to slow the spread of the coronavirus.
- Closure of all non-essential businesses until further notice to help slow the spread of the coronavirus.
- Maintain social distancing of at least 6 feet from other people and refrain from social gatherings of more than 10 people to help slow the spread of the coronavirus.
- Increased funding for emergency care.
- Fine individuals who violate social distancing ordinances.
- Arrest individuals who violate social distancing ordinances.
Government response priorities
With regard to how the government should respond to the COVID-19 pandemic, to what extent do you agree with the following:
- Getting the economy back on track should be the most important factor in government decisions about COVID-19 policies
- Saving the most lives should be the most important factor in government decisions about COVID-19 policies
- The government should impose more restrictions on people to help stop the spread of coronavirus
- The government should let individuals choose individually how they want to behave to protect themselves and others from the coronavirus
Differential policies for young and old
To balance the needs of public health with the needs of the economy, one proposed policy is to allow some members of society to go about their day-to-day activities with lesser restrictions than other members. For example, young people might be allowed to meet each other for coffee while older or more vulnerable groups are required to remain at home. To what extent would disagree or agree with such a policy?
Plot
get_coeff = function (x) {
m <- paste0(x, " ~ condition")
m_coeff <- anova(lm(m, data = data_test))
return(sprintf("F = %.2f, p = %.2f", m_coeff$`F value`[1], m_coeff$`Pr(>F)`[1]))
}
data_test <- data_policy
policy_labels <- data_tidy %>%
filter(survey_name == "policy") %>%
dplyr::select(SID, item, value) %>%
mutate(name = ifelse(item == "policy_1", "Funding for coronavirus research/vaccine",
ifelse(item == "policy_2", "2 weeks paid sick leave for workers with kids",
ifelse(item == "policy_3", "67% of average monthly earnings for unemployment",
ifelse(item == "policy_4", "Free coronavirus testing for US residents",
ifelse(item == "policy_5", "Two rounds of direct payment $1000 each",
ifelse(item == "policy_6", "Expand small business loan coverage",
ifelse(item == "policy_7", "Bailouts for large corporations",
ifelse(item == "policy_8", "Closing borders to non US residents",
ifelse(item == "policy_9", "Increased government surveillance",
ifelse(item == "policy_10", "Closing immigration courts/detention centers",
ifelse(item == "policy_11", "Publicly funded health insurance (Medicare)",
ifelse(item == "policy_12", "Expand food assistance programs (SNAP/WIC)",
ifelse(item == "policy_13", "Require all non-essentials to shelter-in-place",
ifelse(item == "policy_14", "Closure of all non-essential businesses",
ifelse(item == "policy_15", "Maintain social distancing (>6 ft from others)",
ifelse(item == "policy_16", "Increased funding for emergency care.",
ifelse(item == "policy_17", "Fine individuals who violate social distancing",
ifelse(item == "policy_18", "Arrest individuals who violate social distancing", item))))))))))))))))))) %>%
dplyr::select(-SID, -value) %>%
unique() %>%
mutate(label = lapply(item, get_coeff)) %>%
arrange(item)
data_tidy %>%
filter(survey_name == "policy") %>%
mutate(survey_name = ifelse(survey_name == "policy", item, survey_name)) %>%
left_join(., policy_labels, by = "item") %>%
plot_hypothesis(survey = "policy", palette = palette_cond_humorstudy) +
ylab("Policy support scale") +
scale_x_discrete(name ="Policy choice", labels = policy_labels$name, expand = c(.1, .5)) +
ylim(NA, 9) +
geom_text(aes(y=7.5, label=label, hjust=0), angle=0, size=3) +
coord_flip() +
labs(caption = "NOTE: stats correspond to anova results") +
theme(axis.text.y = element_text(angle = 25, hjust = 1)) +
ggtitle("Proposed policies")

data_policy = data_tidy %>%
filter(survey_name == "policy2") %>%
dplyr::select(SID, condition, item, value) %>%
spread(item, value)
data_test <- data_policy
policy_labels <- data_tidy %>%
filter(survey_name == "policy2") %>%
dplyr::select(item) %>%
unique() %>%
mutate(label = lapply(item, get_coeff)) %>%
arrange(item)
data_tidy %>%
filter(!is.na(condition)) %>%
filter(survey_name == "policy2") %>%
mutate(survey_name = ifelse(survey_name == "policy2", item, survey_name)) %>%
left_join(., policy_labels, by = "item") %>%
plot_hypothesis(survey = "policy2", palette = palette_cond_humorstudy)+
ylab("Policy support scale") +
scale_x_discrete(name ="Policy choice", labels = c("Getting the economy back",
"Saving the most lives",
"Impose more restrictions on people",
"Let individuals choose individually how to behave")) +
ylim(NA, 10) +
geom_text(aes(y=7.5, label=label, hjust=0), angle=0, size=3) +
coord_flip() +
theme(axis.text.y = element_text(angle = 25, hjust = 1)) +
ggtitle("Government response priorities")

